(require 'zpng)
(require 'cl-jpeg)

(defun jpeg-rgb (jpegSrc)
  (multiple-value-bind (img h w) (jpeg:decode-image jpegSrc)
    (values w 
	    h
	    (lambda (x y) 
	      (let* ((arrpos (* 3 (+ x (* y w))))
		     (blue (svref img arrpos))
		     (green (svref img (1+ arrpos)))
		     (red (svref img (+ 2 arrpos))))
		(list red green blue))))))

(defun in-bounds (w h) (lambda (x y) (and (>= x 0) (>= y 0) (< x w) (< y h))))

; (+ 1 2)

(defun points-around (x y fbounds)
	   (labels ((shift (dxdy) (list (+ x (first dxdy)) (+ y (second dxdy))))
		    (bound (xy) (funcall fbounds (first xy) (second xy))))
	     (remove-if-not #'bound
			    (mapcar #'shift '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1))))))

(defun color-diff (c1 c2)
  (+ 
   (abs (- (first c1) (first c2)))
   (abs (- (second c1) (second c2)))
   (abs (- (third c1) (third c2)))))

(defun same-color-around (x y fbounds rgbf)
  (let ((c0 (funcall rgbf x y)))
    (some 
     ; (lambda (e) (equal c0 (funcall rgbf (first e) (second e))))
     (lambda (e) (< (color-diff c0 (funcall rgbf (first e) (second e))) 10))
     (points-around x y fbounds))))

(defun find-max-points2( jpegSrc pngDest )
  (multiple-value-bind (w h rgbf) (jpeg-rgb jpegSrc)
    (format t "opened-2 jpeg w=~a h=~a  ~%" w h )

    (let* ((png (make-instance 'zpng:png
			       :color-type :truecolor
			       :width w
			       :height h))
	   (arrPng (zpng:data-array png))
	   (bound (in-bounds w h)))

      (loop for x fixnum from 0 to (1- w) 
	 do (loop for y fixnum from 0 to (1- h)

		 do (let ((rgb 
			   (if (same-color-around x y bound rgbf) '(255 255 0) 
			       '(0 0 255))))
			       ; (funcall rgbf x y))))
		      (setf (aref arrPng y x 0) (first rgb))
		      (setf (aref arrPng y x 1) (second rgb))
		      (setf (aref arrPng y x 2) (third rgb)))))
      (format t "saving ~a~%" pngDest)
      (zpng:write-png png pngDest))))	       

(defun png-array-set (arr-png x y rgb)
  (setf (aref arr-png y x 0) (first rgb))
  (setf (aref arr-png y x 1) (second rgb))
  (setf (aref arr-png y x 2) (third rgb)))
  
(defun graph-cut-data (jpeg-src ycut)
  (multiple-value-bind (w h rgbf) (jpeg-rgb jpeg-src)
    (format t "opened-2 jpeg w=~a h=~a  ~%" w h )
    (let ((graph-data))
      (loop for x from 0 to (1- w)
	 do (let ((c (funcall rgbf x ycut)))
;	      (format t "x ~a color ~a ~%" x c))))))
	      (push c graph-data)))
      (nreverse graph-data))))

(defun rgb-to-gray (rgb) (truncate (/ (+ (first rgb) (second rgb) (third rgb)) 3)))

(defun jpeg-gray-histo (jpeg-src)
   (multiple-value-bind (w h rgbf) (jpeg-rgb jpeg-src)
     (format t "opened for histo jpeg w=~a h=~a  ~%" w h )
     (let ((histo (make-array 256 :initial-element 0)))
       (loop for x from 0 to (1- w)
	      do (loop for y from 0 to (1- h)
		    do (incf (aref histo (rgb-to-gray (funcall rgbf x y))))))
       histo)))

(defun graph-data-gray (data)
  (mapcar 
   (lambda (v) (list (truncate (/ (+ (first v) (second v) (third v)) 3)))) 
   data))

(defun graph-data-max (data)
  (cond 
    ((null data) 0)
    ((atom data) data)
    ((consp data) (max (graph-data-max (car data)) (graph-data-max (cdr data))))))

(defun rgb-3-colors ()
  '((255 0 0) (0 255 0) (0 0 255)))

(defun rgb-3-color-units ()
  '((1 0 0) (0 1 0) (0 0 1)))


(defun fill-png (arr-png w h rgb)
  (loop for x from 0 to (1- w)
       do (loop for y from 0 to (1- h)
	     do (png-array-set arr-png x y rgb))))

(defun graph-png (out-png data colors)
  (let* ((w (length data))
	 (h (max 255 (graph-data-max data)))
	 (png (make-instance 'zpng:png
			     :color-type :truecolor
			     :width w
			     :height (1+ h)))
	 (arr-png (zpng:data-array png)))
;    (format t "w ~a h ~a
 ;   (fill-png arr-png w (1+ h) '(0 0 255))
    (loop for x from 0 to (1- w)
	 do (let ((xvals (nth x data)))
	      (loop for z from 0 to (1- (length xvals))
		 do (png-array-set arr-png x (- h (nth z xvals)) (nth z colors))))) 
    (zpng:write-png png out-png)))

(defun graph-png-column (out-png data show-idx)
  (let* ((w (length data))
	 (h (max 255 (graph-data-max data)))
	 (png (make-instance 'zpng:png
			     :color-type :truecolor
			     :width w
			     :height (1+ h)))
	 (arr-png (zpng:data-array png)))
    (loop for x from 0 to (1- w)
	 do (let ((v (nth show-idx (nth x data))))
	      (loop for y from (- h v) to h
		 do (png-array-set arr-png x y '(255 255 128)))))
    (zpng:write-png png out-png)))

(defun graph-png-vbar (arr-png x y1 y2 color)
  (loop for y from y1 to y2 
       do (png-array-set arr-png x y color)))

(defun color-mul (c mul)
  (list (* mul (first c)) (* mul (second c)) (* mul (third c))))

(defun graph-png-stripes (out-png data color-units w-stripe)
  (let* ((w (length data))
	 (h (* w-stripe 2 (length color-units)))
	 (png (make-instance 'zpng:png
			     :color-type :truecolor
			     :width w
			     :height (1+ h)))
	 (arr-png (zpng:data-array png)))
    (loop for x from 0 to (1- w)
	 do (let ((xvals (nth x data)))
	      (loop for z from 0 to (1- (length xvals))
		 do (graph-png-vbar arr-png x (* w-stripe 2 z) (+ w-stripe (* w-stripe 2 z)) 
				    (color-mul (nth z color-units) (nth z xvals))))))
    (zpng:write-png png out-png)))

;(find-max-points2 "/opt/project/4shared/modules/skincolor/src/main/resources/texture/asphalt.jpg" "/tmp/31a.png")

(defun random-gauss ()
  (let ((acc 0)
	(count 12))
    (dotimes (x count) (incf acc (random 1.0d0)))
    (1- (/ acc 6))))

(defun random-gauss-gray-val (x y)
  (let* ((r (random-gauss))
	 (g (truncate (+ 100 (* r 100))))
	 (g1 (if (> x 200) g (+ 5 g))))
    g1))

(defun random-gauss-gray-color (x y)
  (let ((gv (random-gauss-gray-val x y)))
    (list gv gv gv)))


(defun random-gray-color ()
  (let ((g (random 256)))
    (list g g g)))

(defun png-from-color-function (out-png w h color-function)
  (let* ((png (make-instance 'zpng:png
			     :color-type :truecolor
			     :width w
			     :height h))
	 (arr-png (zpng:data-array png)))
    (labels ()
      (loop for x from 0 to (1- w)
	 do (loop for y from 0 to (1- h)
	       do (png-array-set arr-png x y 
				 (funcall color-function x y)))))
    (zpng:write-png png out-png)))

(defun noisy-edge-1d ()
  (loop for x from 0 to 499 collect (list (first (random-gauss-gray-color x 0)))))

(defun noisy-edge-graph (out-png)
  (let ((d (noisy-edge-1d)))
    (graph-png-column out-png d 0)))

(defun noise-edge-lines (out-png)
  (let ((d (noisy-edge-1d)))
    (labels ((f (x y)
	       (let ((g (first (nth x d))))
		 (list g g g))))
      (png-from-color-function out-png 500 300 #'f))))

(defun gray-make-array (func w h)
  (let ((a (make-array (list h w))))
    (loop for row from 0 to (1- h)
	 do (loop for col from 0 to (1- w)
		 do (setf (aref a row col) (funcall func col row))))
    a))

(defun gray-png-from-array (out-png arr)
  (destructuring-bind (h w) (array-dimensions arr)
    (png-from-color-function out-png w h 
			     (lambda (x y) 
			       (let ((g (aref arr y x)))
				 (list g g g))))))
  
(defun gray-sum-square (arr x y size)
  (let ((s 0))
    (loop for row from y to (+ y size -1)
       do (loop for col from x to (+ x size -1)
	     do (incf s (aref arr row col))))
    s))

(defun gray-delta-sum-square (arr x y size)
  (let ((s2 (truncate (/ size 2))))
    (- (gray-sum-square arr x (- y s2) size) (gray-sum-square arr (- x size) (- y s2) size))))

(defun gray-edge-average ()
    (let* ((w 500)
	  (h 300)
	  (a (gray-make-array #'random-gauss-gray-val  w h))
	  (smoo 50))
      (gray-png-from-array "/tmp2/ga1.png" a)
      (let ((asmoo (gray-make-array 
		    (lambda (x y) (truncate (/ (gray-sum-square a x y smoo) (* smoo smoo))))
		    (- w smoo)
		    (- h smoo))))
	(gray-png-from-array "/tmp2/ga1smoo.png" asmoo))))


(defun gray-find-edge ()
  (let ((a (gray-make-array #'random-gauss-gray-val  500 300)))
    (gray-png-from-array "/tmp2/ga1.png" a)
    (let ((grdata nil))
      (loop for x from 100 to 300 
	 do (let ((v (gray-delta-sum-square a x 50 50)))
	      (format t "x ~a  dsum ~a ~%" x v)
	      (setf grdata (append grdata (list (list (+ 300 (truncate (/ v 50)))))))))
      (format t "~a ~%" grdata)
      (graph-png-column "/tmp2/garg.png" grdata 0))))
      



;; (defmacro manyf (from to)
;;   (do ((r (list 'progn))
;;        (i from (1+ i)))
;;       ((> i to) (nreverse r))
;;     (push `(defun ,(intern (format nil "f~a" i)) (x) (+ ,i x)) r))) 

;; (graph-png-column "/tmp/z.png" (mapcar (lambda (x) (list (truncate (/ x 3)))) (coerce 
;; 			 (jpeg-gray-histo "/opt/project/4shared/modules/skincolor/src/main/resources/texture/asphalt.jpg")
;; 	  'list)) 0)


;; (defun draw-mandelbrot (file)
;;   (let* ((png (make-instance 'zpng:png
;;                              :color-type :grayscale-alpha
;;                              :width 200
;;                              :height 200))
;;          (image (zpng:data-array png))
;;          (max 255))
;;     (dotimes (y 200 (zpng:write-png png file))
;;       (dotimes (x 200)
;;         (let ((c (complex (- (/ x 100.0) 1.5) (- (/ y 100.0) 1.0)))
;;               (z (complex 0.0 0.0))
;;               (iteration 0))
;;           (loop
;;            (setf z (+ (* z z) c))
;;            (incf iteration)
;;            (cond ((< 4 (abs z))
;;                   (setf (aref image y x 1) iteration)
;;                   (return))
;;                  ((= iteration max)
;;                   (setf (aref image y x 1) 255)
;;                   (return)))))))))


;; (defun test-create-png-data ()
;;   (let ((a (make-array (list 10 5 3) :element-type '(unsigned-byte 8)))) 
;; 	   (setf (aref a 0 2 1) 255) a))

;; (defun test-create-png (file)
;;   (let* ((png (make-instance 'zpng:png
;; 			     :color-type :truecolor
;;                              :width 5
;;                              :height 10
;; ;			     :image-data (test-create-png-data)
;; 			     ))
;; 	 (a (zpng:data-array png))
;; 	 )
;;     (setf (aref a 0 2 1) 255)
;;     (setf (aref a 1 3 2) 255)
;;     (print (zpng:data-array png))
;;     (zpng:write-png png file)))

;; (draw-mandelbrot "/tmp/3.png")
;;  (test-create-png "/tmp/5.png")